home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / share / perl5 / Time / Zone.pm
Text File  |  2002-09-16  |  8KB  |  285 lines

  1.  
  2. package Time::Zone;
  3.  
  4. =head1 NAME
  5.  
  6. Time::Zone -- miscellaneous timezone manipulations routines
  7.  
  8. =head1 SYNOPSIS
  9.  
  10.     use Time::Zone;
  11.     print tz2zone();
  12.     print tz2zone($ENV{'TZ'});
  13.     print tz2zone($ENV{'TZ'}, time());
  14.     print tz2zone($ENV{'TZ'}, undef, $isdst);
  15.     $offset = tz_local_offset();
  16.     $offset = tz_offset($TZ);
  17.  
  18. =head1 DESCRIPTION
  19.  
  20. This is a collection of miscellaneous timezone manipulation routines.
  21.  
  22. C<tz2zone()> parses the TZ environment variable and returns a timezone
  23. string suitable for inclusion in L<date>-like output.  It opionally takes
  24. a timezone string, a time, and a is-dst flag.
  25.  
  26. C<tz_local_offset()> determins the offset from GMT time in seconds.  It
  27. only does the calculation once.
  28.  
  29. C<tz_offset()> determines the offset from GMT in seconds of a specified
  30. timezone.  
  31.  
  32. C<tz_name()> determines the name of the timezone based on its offset
  33.  
  34. =head1 AUTHORS
  35.  
  36. Graham Barr <gbarr@pobox.com>
  37. David Muir Sharnoff <muir@idiom.com>
  38. Paul Foley <paul@ascent.com>
  39.  
  40. =cut
  41.  
  42. require 5.002;
  43.  
  44. require Exporter;
  45. use Carp;
  46. use strict;
  47. use vars qw(@ISA @EXPORT $VERSION @tz_local);
  48.  
  49. @ISA = qw(Exporter);
  50. @EXPORT = qw(tz2zone tz_local_offset tz_offset tz_name);
  51. $VERSION = "2.22";
  52.  
  53. # Parts stolen from code by Paul Foley <paul@ascent.com>
  54.  
  55. sub tz2zone (;$$$)
  56. {
  57.     my($TZ, $time, $isdst) = @_;
  58.  
  59.     use vars qw(%tzn_cache);
  60.  
  61.     $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : ''
  62.         unless $TZ;
  63.  
  64.     # Hack to deal with 'PST8PDT' format of TZ
  65.     # Note that this can't deal with all the esoteric forms, but it
  66.     # does recognize the most common: [:]STDoff[DST[off][,rule]]
  67.  
  68.     if (! defined $isdst) {
  69.         my $j;
  70.         $time = time() unless $time;
  71.         ($j, $j, $j, $j, $j, $j, $j, $j, $isdst) = localtime($time);
  72.     }
  73.  
  74.     if (defined $tzn_cache{$TZ}->[$isdst]) {
  75.         return $tzn_cache{$TZ}->[$isdst];
  76.     }
  77.       
  78.     if ($TZ =~ /^
  79.             ( [^:\d+\-,] {3,} )
  80.             ( [+-] ?
  81.               \d {1,2}
  82.               ( : \d {1,2} ) {0,2} 
  83.             )
  84.             ( [^\d+\-,] {3,} )?
  85.             /x
  86.         ) {
  87.         my $dsttz = defined($4) ? $4 : $1;
  88.         $TZ = $isdst ? $dsttz : $1;
  89.         $tzn_cache{$TZ} = [ $1, $dsttz ];
  90.     } else {
  91.         $tzn_cache{$TZ} = [ $TZ, $TZ ];
  92.     }
  93.     return $TZ;
  94. }
  95.  
  96. sub tz_local_offset (;$)
  97. {
  98.     my ($time) = @_;
  99.  
  100.     $time = time() unless $time;
  101.     my (@l) = localtime($time);
  102.     my $isdst = $l[8];
  103.  
  104.     if (defined($tz_local[$isdst])) {
  105.         return $tz_local[$isdst];
  106.     }
  107.  
  108.     $tz_local[$isdst] = &calc_off($time);
  109.  
  110.     return $tz_local[$isdst];
  111. }
  112.  
  113. sub calc_off
  114. {
  115.     my ($time) = @_;
  116.  
  117.     my (@l) = localtime($time);
  118.     my (@g) = gmtime($time);
  119.  
  120.     my $off;
  121.  
  122.     $off =     $l[0] - $g[0]
  123.         + ($l[1] - $g[1]) * 60
  124.         + ($l[2] - $g[2]) * 3600;
  125.  
  126.     # subscript 7 is yday.
  127.  
  128.     if ($l[7] == $g[7]) {
  129.         # done
  130.     } elsif ($l[7] == $g[7] + 1) {
  131.         $off += 86400;
  132.     } elsif ($l[7] == $g[7] - 1) {
  133.         $off -= 86400;
  134.     } elsif ($l[7] < $g[7]) {
  135.         # crossed over a year boundry!
  136.         # localtime is beginning of year, gmt is end
  137.         # therefore local is ahead
  138.         $off += 86400;
  139.     } else {
  140.         $off -= 86400;
  141.     }
  142.  
  143.     return $off;
  144. }
  145.  
  146. # constants
  147.  
  148. CONFIG: {
  149.     use vars qw(%dstZone %zoneOff %dstZoneOff %Zone);
  150.  
  151.     my @dstZone = (
  152.     #   "ndt"  =>   -2*3600-1800,     # Newfoundland Daylight   
  153.         "brst" =>   -2*3600,         # Brazil Summer Time (East Daylight)
  154.         "adt"  =>   -3*3600,       # Atlantic Daylight   
  155.         "edt"  =>   -4*3600,       # Eastern Daylight
  156.         "cdt"  =>   -5*3600,       # Central Daylight
  157.         "mdt"  =>   -6*3600,       # Mountain Daylight
  158.         "pdt"  =>   -7*3600,       # Pacific Daylight
  159.         "ydt"  =>   -8*3600,       # Yukon Daylight
  160.         "hdt"  =>   -9*3600,       # Hawaii Daylight
  161.         "bst"  =>   +1*3600,       # British Summer   
  162.         "mest" =>   +2*3600,       # Middle European Summer   
  163.         "sst"  =>   +2*3600,       # Swedish Summer
  164.         "fst"  =>   +2*3600,       # French Summer
  165.             "cest" =>   +2*3600,         # Central European Daylight
  166.             "eest" =>   +3*3600,         # Eastern European Summer
  167.         "wadt" =>   +8*3600,       # West Australian Daylight
  168.         "kdt"  =>  +10*3600,     # Korean Daylight
  169.     #   "cadt" =>  +10*3600+1800,     # Central Australian Daylight
  170.         "eadt" =>  +11*3600,       # Eastern Australian Daylight
  171.         "nzd"  =>  +13*3600,       # New Zealand Daylight   
  172.         "nzdt" =>  +13*3600,       # New Zealand Daylight   
  173.     );
  174.  
  175.     my @Zone = (
  176.         "gmt"    =>   0,       # Greenwich Mean
  177.         "ut"        =>   0,       # Universal (Coordinated)
  178.         "utc"       =>   0,
  179.         "wet"       =>   0,       # Western European
  180.         "wat"       =>  -1*3600,     # West Africa
  181.         "at"        =>  -2*3600,     # Azores
  182.         "fnt"    =>  -2*3600,     # Brazil Time (Extreme East - Fernando Noronha)
  183.         "brt"    =>  -3*3600,     # Brazil Time (East Standard - Brasilia)
  184.     # For completeness.  BST is also British Summer, and GST is also Guam Standard.
  185.     #   "bst"       =>  -3*3600,     # Brazil Standard
  186.     #   "gst"       =>  -3*3600,     # Greenland Standard
  187.     #   "nft"       =>  -3*3600-1800,# Newfoundland
  188.     #   "nst"       =>  -3*3600-1800,# Newfoundland Standard
  189.         "mnt"    =>  -4*3600,     # Brazil Time (West Standard - Manaus)
  190.         "ewt"       =>  -4*3600,     # U.S. Eastern War Time
  191.         "ast"       =>  -4*3600,     # Atlantic Standard
  192.         "est"       =>  -5*3600,     # Eastern Standard
  193.         "act"    =>  -5*3600,     # Brazil Time (Extreme West - Acre)
  194.         "cst"       =>  -6*3600,     # Central Standard
  195.         "mst"       =>  -7*3600,     # Mountain Standard
  196.         "pst"       =>  -8*3600,     # Pacific Standard
  197.         "yst"    =>  -9*3600,     # Yukon Standard
  198.         "hst"    => -10*3600,     # Hawaii Standard
  199.         "cat"    => -10*3600,     # Central Alaska
  200.         "ahst"    => -10*3600,     # Alaska-Hawaii Standard
  201.         "nt"    => -11*3600,     # Nome
  202.         "idlw"    => -12*3600,     # International Date Line West
  203.         "cet"    =>  +1*3600,      # Central European
  204.         "mez"    =>  +1*3600,      # Central European (German)
  205.         "ect"    =>  +1*3600,      # Central European (French)
  206.         "met"    =>  +1*3600,      # Middle European
  207.         "mewt"    =>  +1*3600,      # Middle European Winter
  208.         "swt"    =>  +1*3600,      # Swedish Winter
  209.         "set"    =>  +1*3600,      # Seychelles
  210.         "fwt"    =>  +1*3600,      # French Winter
  211.         "eet"    =>  +2*3600,      # Eastern Europe, USSR Zone 1
  212.         "ukr"    =>  +2*3600,      # Ukraine
  213.         "bt"    =>  +3*3600,      # Baghdad, USSR Zone 2
  214.     #   "it"    =>  +3*3600+1800,# Iran
  215.         "zp4"    =>  +4*3600,      # USSR Zone 3
  216.         "zp5"    =>  +5*3600,      # USSR Zone 4
  217.     #   "ist"    =>  +5*3600+1800,# Indian Standard
  218.         "zp6"    =>  +6*3600,      # USSR Zone 5
  219.     # For completeness.  NST is also Newfoundland Stanard, and SST is also Swedish Summer.
  220.     #   "nst"    =>  +6*3600+1800,# North Sumatra
  221.     #   "sst"    =>  +7*3600,      # South Sumatra, USSR Zone 6
  222.     #   "jt"    =>  +7*3600+1800,# Java (3pm in Cronusland!)
  223.         "wst"    =>  +8*3600,      # West Australian Standard
  224.         "hkt"    =>  +8*3600,      # Hong Kong
  225.         "cct"    =>  +8*3600,      # China Coast, USSR Zone 7
  226.         "jst"    =>  +9*3600,     # Japan Standard, USSR Zone 8
  227.         "kst"    =>  +9*3600,     # Korean Standard
  228.     #   "cast"    =>  +9*3600+1800,# Central Australian Standard
  229.         "east"    => +10*3600,     # Eastern Australian Standard
  230.         "gst"    => +10*3600,     # Guam Standard, USSR Zone 9
  231.         "nzt"    => +12*3600,     # New Zealand
  232.         "nzst"    => +12*3600,     # New Zealand Standard
  233.         "idle"    => +12*3600,     # International Date Line East
  234.     );
  235.  
  236.     %Zone = @Zone;
  237.     %dstZone = @dstZone;
  238.     %zoneOff = reverse(@Zone);
  239.     %dstZoneOff = reverse(@dstZone);
  240.  
  241. }
  242.  
  243. sub tz_offset (;$$)
  244. {
  245.     my ($zone, $time) = @_;
  246.  
  247.     return &tz_local_offset($time) unless($zone);
  248.  
  249.     $time = time() unless $time;
  250.     my(@l) = localtime($time);
  251.     my $dst = $l[8];
  252.  
  253.     $zone = lc $zone;
  254.  
  255.     if($zone =~ /^(([\-\+])\d\d?)(\d\d)$/) {
  256.         my $v = $2 . $3;
  257.         return $1 * 3600 + $v * 60;
  258.     } elsif (exists $dstZone{$zone} && ($dst || !exists $Zone{$zone})) {
  259.         return $dstZone{$zone};
  260.     } elsif(exists $Zone{$zone}) {
  261.         return $Zone{$zone};
  262.     }
  263.     undef;
  264. }
  265.  
  266. sub tz_name (;$$)
  267. {
  268.     my ($off, $dst) = @_;
  269.  
  270.     $off = tz_offset()
  271.         unless(defined $off);
  272.  
  273.     $dst = (localtime(time))[8]
  274.         unless(defined $dst);
  275.  
  276.     if (exists $dstZoneOff{$off} && ($dst || !exists $zoneOff{$off})) {
  277.         return $dstZoneOff{$off};
  278.     } elsif (exists $zoneOff{$off}) {
  279.         return $zoneOff{$off};
  280.     }
  281.     sprintf("%+05d", int($off / 60) * 100 + $off % 60);
  282. }
  283.  
  284. 1;
  285.